home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / setmem.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  5.8 KB  |  152 lines

  1.       subroutine setmem(ipntr,ksize)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine performs dynamic memory management.  it is used in
  5. c     spice2, and useable in any program.
  6. c
  7. c     memory is managed within an array selected by the calling program.
  8. c     one may either dimension this array to the 'maxmem' size, or more
  9. c     desirably, find the address of the first available word of memory
  10. c     above your program, and dimension your array to '1'.  passing the
  11. c     address of the first data word available permits the manager to
  12. c     use 'illegal' indices into the data area.
  13. c
  14. c     this routine must have access to an integer function called 'locf'
  15. c     which returns the address of its argument.  addresses as used by this
  16. c     program refer to 'integer' addresses, not byte addresses.
  17. c
  18. c entry points:
  19. c      setmem - set initial memory
  20. c      getm4  - get block for table of integers
  21. c      getm8  - get block for table of floating point variables
  22. c      getm16 - get block for table of complex variables
  23. c      relmem - release part of block
  24. c      extmem - extend size of existing block
  25. c      sizmem - determine size of existing block
  26. c      clrmem - release block
  27. c      ptrmem - reset memory pointer
  28. c      crunch - force memory compaction
  29. c      avlm4  - amount of space available (integers)
  30. c      avlm8  - amount of space available (real)
  31. c      avlm16 - amount of space available (complex)
  32. c
  33. c calling sequences:
  34. c      call setmem(imem(1),maxmem)
  35. c      call setmem(imem(1),maxmem,kfamwa)  cdc machines running under
  36. c                                          calidoscope kfamwa is the address
  37. c                                          of the first available word
  38. c      call getm4 (ipntr,blksiz)  where blksize is the number of entries
  39. c      call getm8 (ipntr,blksiz)
  40. c      call getm16(ipntr,blksiz)
  41. c      call relmem(ipntr,relsiz)
  42. c      call extmem(ipntr,extsiz)  extsiz is the number of entries to be added
  43. c      call sizmem(ipntr,blksiz)
  44. c      call clrmem(ipntr)
  45. c      call ptrmem(ipntr1,ipntr2)
  46. c      call avlm4(ispace)
  47. c      call avlm8(ispace)
  48. c      call avlm16(ispace)
  49. c      call crunch
  50. c      call slpmem(ipntr,slpsiz)  express desire for *slpsiz* extra entries
  51. c
  52. c
  53. c general comments:
  54. c      for each block which is allocated, a multi-word entry is maintained
  55. c in a table kept in high memory, of the form
  56. c
  57. c        word      contents
  58. c        ----      --------
  59. c
  60. c          1       index of imem(.) into origin of block
  61. c                    i.e. contents of pointer (used for error check)
  62. c          2       block size (in words)
  63. c          3       number of words in use
  64. c          4       address of variable containing block origin
  65. c          5       number of words used per table entry
  66. c          6       slop size (in words)
  67. c
  68. c      all allocated blocks are an 'even' (nxtevn) number of words in length,
  69. c where a 'word' is the storage unit required for an 'integer' variable.
  70. c      since block repositioning may be necessary, the convention that
  71. c only one variable contain a block origin should be observed.
  72. c      for *getmem*, *ipntr* is set such that *array(ipntr+1)* is the
  73. c first word of the allocated block.  'ipntr' is set to address the first
  74. c entry of the table when used with the appropriate variable type, i.e.,
  75. c nodplc(ipntr+1), value(ipntr+1), or cvalue(ipntr+1).
  76. c      for *clrmem*, *ipntr* is set to 'invalid' to enable rapid detection
  77. c of an attempt to use a cleared block.
  78. c      if any fatal errors are found, a message is printed and a flag
  79. c set inhibiting further action until *setmem* is called.  (in this
  80. c context, insufficient memory is considered a fatal error.)
  81. c      throughout this routine, *ldval* always contains the subscript of
  82. c the last addressable word of memory, *memavl* always contains the
  83. c number of available words of memory, *numblk* always contains the
  84. c number of allocated blocks, and istack(*loctab* +1) always contains
  85. c the first word of the block table.
  86. c
  87. c spice version 2g.6  sccsid=blank 3/15/83
  88.       common /blank/ value(200000)
  89. c spice version 2g.6  sccsid=memmgr 3/15/83
  90.       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
  91.      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
  92.      2   nwd8,nwd16
  93.       dimension ipntr(1)
  94. c
  95.       logical memptr
  96.       complex cvalue(32)
  97.       equivalence (value(1),cvalue(1))
  98.       external locf
  99. c
  100. c...  approximate time required to copy *nwords* integer values
  101. c
  102. c  nxtevn rounds the number up to the next 'even' value.  the value
  103. c  used for this 'even' number is the smallest number into which one
  104. c  can divide nwd4,nwd8,and nwd16.
  105. c
  106. c
  107. c  nxtmem  returns next higher memory size
  108. c
  109. c
  110. c
  111. c***  setmem - set initial memory
  112. c
  113.       nwd4=1
  114.       nwd8=locf(value(2))-locf(value(1))
  115.       nwd16=locf(cvalue(2))-locf(cvalue(1))
  116.       memerr=0
  117.       nevn=nxtevn(1)
  118. c     check that nxtevn function returns a number divisible by
  119. c     nwd4, nwd8, nwd16; also check that the memory increment
  120. c     nxtmem(.) is an integer multiple of nxtevn(1)
  121.       icheck=mod(nevn,nwd4)+mod(nevn,nwd8)+mod(nevn,nwd16)+
  122.      1  mod(nxtmem(1),nevn)
  123.       if(icheck.eq.0) go to 2
  124.       memerr=1
  125.       call errmem(6,memerr,ipntr(1))
  126.     2 cpyknt=0.0d0
  127.       ifamwa=locf(ipntr(1))
  128.       maxmem=ksize
  129.       ntab=nxtevn(6)
  130. c... add 'lorg' to an address and you get the 'istack' index to that word
  131.       lorg=1-locf(istack(1))
  132.       ifwa=ifamwa+lorg-1
  133.       nwoff=locf(ipntr(1))+lorg-1
  134.       icore=nxtmem(1)
  135. c... don't take chances, back off from 'end of memory' by nxtevn(1)
  136.       ldval=ifwa+nxtmem(1)-nxtevn(1)
  137.       memavl=ldval-ntab-ifwa
  138.       maxcor=0
  139.       maxuse=0
  140.       call memory
  141.       if(memerr.ne.0) call errmem(6,memerr,ipntr(1))
  142.       numblk=1
  143.       loctab=ldval-ntab
  144.       istack(loctab+1)=0
  145.       istack(loctab+2)=memavl
  146.       istack(loctab+3)=0
  147.       istack(loctab+4)=-1
  148.       istack(loctab+5)=1
  149.       istack(loctab+6)=0
  150.       return
  151.       end
  152.